home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / POIDEV.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  42 lines
  1. FUNCTION poidev(xm: real; VAR idum: integer): real;
  2. (* Programs using POIDEV must declare the variables
  3. VAR
  4.    gloldm,glsq,glalxm,glg: real;
  5. in the main program and should intialize gloldm to
  6.    gloldm := -1.0;   *)
  7. CONST
  8.    pi=3.141592654;
  9. VAR
  10.    em,t,y: real;
  11. BEGIN
  12.    IF (xm < 12.0) THEN BEGIN
  13.       IF (xm <> gloldm) THEN BEGIN
  14.          gloldm := xm;
  15.          glg := exp(-xm)
  16.       END;
  17.       em := -1;
  18.       t := 1.0;
  19.       REPEAT
  20.          em := em+1.0;
  21.          t := t*ran3(idum);
  22.       UNTIL (t <= glg)
  23.    END ELSE BEGIN
  24.       IF (xm <> gloldm) THEN BEGIN
  25.          gloldm := xm;
  26.          glsq := sqrt(2.0*xm);
  27.          glalxm := ln(xm);
  28.          glg := xm*glalxm-gammln(xm+1.0)
  29.       END;
  30.       REPEAT
  31.          REPEAT
  32.             y := pi*ran3(idum);
  33.             y := sin(y)/cos(y);
  34.             em := glsq*y+xm;
  35.          UNTIL (em >= 0.0);
  36.          em := trunc(em);
  37.          t := 0.9*(1.0+sqr(y))*exp(em*glalxm-gammln(em+1.0)-glg);
  38.       UNTIL (ran3(idum) <= t)
  39.    END;
  40.    poidev := em
  41. END;
  42.